home *** CD-ROM | disk | FTP | other *** search
- /*
-
- This file is part of XEmacs.
-
- XEmacs is free software; you can redistribute it and/or modify it
- under the terms of the GNU General Public License as published by the
- Free Software Foundation; either version 2, or (at your option) any
- later version.
-
- XEmacs is distributed in the hope that it will be useful, but WITHOUT
- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
- for more details.
-
- You should have received a copy of the GNU General Public License
- along with XEmacs; see the file COPYING. If not, write to the Free
- Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
-
- /* Synched up with: Not in FSF. */
-
- #include <config.h>
- #include "lisp.h"
- #include "hash.h"
- #include "elhash.h"
- #include "bytecode.h"
-
- Lisp_Object Qhashtablep;
-
- #define LISP_OBJECTS_PER_HENTRY (sizeof (hentry) / sizeof (Lisp_Object))/* 2 */
-
- struct hashtable_struct
- {
- struct lcrecord_header header;
- unsigned int fullness;
- unsigned long (*hash_function) (CONST void *);
- int (*test_function) (CONST void *, CONST void *);
- Lisp_Object zero_entry;
- Lisp_Object harray;
- enum hashtable_type type; /* whether and how this hashtable is weak */
- Lisp_Object next_weak; /* Used to chain together all of the weak
- hashtables. Don't mark through this. */
- };
-
- static Lisp_Object Vweak_hash_tables;
-
- DECLARE_LRECORD (hashtable, struct hashtable_struct);
- #define XHASHTABLE(x) XRECORD (x, hashtable, struct hashtable_struct)
- #define XSETHASHTABLE(x, p) XSETRECORD (x, p, hashtable)
- #define HASHTABLEP(x) RECORDP (x, hashtable)
- #define CHECK_HASHTABLE(x, i) CHECK_RECORD (x, hashtable)
-
- static Lisp_Object mark_hashtable (Lisp_Object, void (*) (Lisp_Object));
- static void print_hashtable (Lisp_Object, Lisp_Object, int);
- DEFINE_LRECORD_IMPLEMENTATION ("hashtable", hashtable,
- mark_hashtable, print_hashtable, 0, 0, 0,
- struct hashtable_struct);
-
- static Lisp_Object
- mark_hashtable (Lisp_Object obj, void (*markobj) (Lisp_Object))
- {
- struct hashtable_struct *table = XHASHTABLE (obj);
-
- if (table->type != HASHTABLE_NONWEAK)
- {
- /* If the table is weak, we don't want to mark the keys and values
- (we scan over them after everything else has been marked,
- and mark or remove them as necessary). Note that we will mark
- the table->harray itself at the same time; it's hard to mark
- that here without also marking its contents. */
- return Qnil;
- }
- ((markobj) (table->zero_entry));
- return (table->harray);
- }
-
- static void
- print_hashtable (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
- {
- struct hashtable_struct *table = XHASHTABLE (obj);
- char buf[200];
- if (print_readably)
- error ("printing unreadable object #<hashtable 0x%x>",
- table->header.uid);
- sprintf (buf, GETTEXT ("#<%shashtable %d/%ld 0x%x>"),
- (table->type == HASHTABLE_WEAK ? "weak " :
- table->type == HASHTABLE_KEY_WEAK ? "key-weak " :
- table->type == HASHTABLE_VALUE_WEAK ? "value-weak " :
- ""),
- table->fullness,
- (vector_length (XVECTOR (table->harray)) / LISP_OBJECTS_PER_HENTRY),
- table->header.uid);
- write_c_string (buf, printcharfun);
- }
-
- static void
- ht_copy_to_c (struct hashtable_struct *ht,
- c_hashtable c_table)
- {
- int len;
-
- c_table->harray = (void *) vector_data (XVECTOR (ht->harray));
- c_table->zero_set = (!EQ (ht->zero_entry, Qunbound));
- c_table->zero_entry = LISP_TO_VOID (ht->zero_entry);
- len = vector_length (XVECTOR (ht->harray));
- if (len < 0)
- {
- /* #### if alloc.c mark_object() changes, this must change too. */
- /* barf gag retch. When a vector is marked, its len is
- made less than 0. In the prune_weak_hashtables() stage,
- we are called on vectors that are like this, and we must
- be able to deal. */
- assert (gc_in_progress);
- len = -1 - len;
- }
- c_table->size = len/LISP_OBJECTS_PER_HENTRY;
- c_table->fullness = ht->fullness;
- c_table->hash_function = ht->hash_function;
- c_table->test_function = ht->test_function;
- XSETHASHTABLE (c_table->elisp_table, ht);
- }
-
- static void
- ht_copy_from_c (c_hashtable c_table,
- struct hashtable_struct *ht)
- {
- struct Lisp_Vector dummy;
- /* C is truly hateful */
- void *vec_addr
- = ((char *) c_table->harray
- - ((char *) &(dummy.contents) - (char *) &dummy));
-
- XSETVECTOR (ht->harray, vec_addr);
- if (c_table->zero_set)
- VOID_TO_LISP (ht->zero_entry, c_table->zero_entry);
- else
- ht->zero_entry = Qunbound;
- ht->fullness = c_table->fullness;
- }
-
-
- static struct hashtable_struct *
- new_hashtable (void)
- {
- struct hashtable_struct *table
- = alloc_lcrecord (sizeof (struct hashtable_struct), lrecord_hashtable);
- table->harray = Qnil;
- table->zero_entry = Qunbound;
- table->fullness = 0;
- table->hash_function = 0;
- table->test_function = 0;
- return (table);
- }
-
- char *
- elisp_hvector_malloc (unsigned int bytes, Lisp_Object table)
- {
- Lisp_Object new_vector;
- struct hashtable_struct *ht;
-
- ht = XHASHTABLE (table);
- assert (bytes > vector_length (XVECTOR (ht->harray)) * sizeof (Lisp_Object));
- new_vector = make_vector ((bytes / sizeof (Lisp_Object)), Qzero);
- return ((char *) (vector_data (XVECTOR (new_vector))));
- }
-
- void
- elisp_hvector_free (void *ptr, Lisp_Object table)
- {
- struct hashtable_struct *ht = XHASHTABLE (table);
- #if defined (USE_ASSERTIONS) || defined (DEBUG_XEMACS)
- Lisp_Object current_vector = ht->harray;
- #endif
-
- assert (((void *) vector_data (XVECTOR (current_vector))) == ptr);
- ht->harray = Qnil; /* Let GC do its job */
- return;
- }
-
-
- DEFUN ("hashtablep", Fhashtablep, Shashtablep, 1, 1, 0,
- "Return t if OBJ is a hashtable, else nil.")
- (obj)
- Lisp_Object obj;
- {
- return ((HASHTABLEP (obj)) ? Qt : Qnil);
- }
-
- /* C code can specify test and hash function for hash tables of lisp objects
- (including weak tables) but lisp code can only create EQ tables because we
- don't have a general lisp object hash function.
- */
- Lisp_Object
- make_lisp_hashtable (int size,
- int (*test_function) (CONST void*, CONST void*),
- unsigned long (*hash_function) (CONST void*),
- enum hashtable_type type)
- {
- Lisp_Object result;
- struct hashtable_struct *table = new_hashtable ();
- table->harray = make_vector ((compute_harray_size (size)
- * LISP_OBJECTS_PER_HENTRY),
- Qzero);
- table->test_function = test_function;
- table->hash_function = hash_function;
- table->type = type;
- XSETHASHTABLE (result, table);
-
- if (table->type != HASHTABLE_NONWEAK)
- {
- table->next_weak = Vweak_hash_tables;
- Vweak_hash_tables = result;
- }
- else
- table->next_weak = Qunbound;
-
- return (result);
- }
-
- DEFUN ("make-hashtable", Fmake_hashtable, Smake_hashtable, 1, 1, 0,
- "Make a hashtable of initial size SIZE.")
- (size)
- Lisp_Object size;
- {
- CHECK_NATNUM (size, 0);
- return make_lisp_hashtable (XINT (size), 0, 0, HASHTABLE_NONWEAK);
- }
-
- DEFUN ("copy-hashtable", Fcopy_hashtable, Scopy_hashtable, 1, 1, 0,
- "Make a new hashtable which contains the same keys and values\n\
- as the given table. The keys and values will not themselves be copied.")
- (old_table)
- Lisp_Object old_table;
- {
- struct _C_hashtable old_htbl;
- struct _C_hashtable new_htbl;
- struct hashtable_struct *old_ht;
- struct hashtable_struct *new_ht;
- Lisp_Object result;
-
- CHECK_HASHTABLE (old_table, 0);
- old_ht = XHASHTABLE (old_table);
- ht_copy_to_c (old_ht, &old_htbl);
-
- /* we can't just call Fmake_hashtable() here because that will make a
- table that is slightly larger than the one we're trying to copy,
- which will make copy_hash() blow up. */
- new_ht = new_hashtable ();
- new_ht->fullness = 0;
- new_ht->zero_entry = Qunbound;
- new_ht->hash_function = old_ht->hash_function;
- new_ht->test_function = old_ht->test_function;
- new_ht->harray = Fmake_vector (Flength (old_ht->harray), Qzero);
- ht_copy_to_c (new_ht, &new_htbl);
- copy_hash (&new_htbl, &old_htbl);
- ht_copy_from_c (&new_htbl, new_ht);
- new_ht->type = old_ht->type;
- XSETHASHTABLE (result, new_ht);
-
- if (EQ (old_ht->next_weak, Qunbound))
- new_ht->next_weak = Qunbound;
- else
- {
- new_ht->next_weak = Vweak_hash_tables;
- Vweak_hash_tables = result;
- }
-
- return (result);
- }
-
-
- DEFUN ("gethash", Fgethash, Sgethash, 2, 3, 0,
- "Find hash value for KEY in TABLE.\n\
- If there is no corresponding value, return DEFAULT (defaults to nil).")
- (key, table, defalt)
- Lisp_Object key, table, defalt; /* One can't even spell correctly in C */
- {
- CONST void *vval;
- struct _C_hashtable htbl;
- if (!gc_in_progress)
- CHECK_HASHTABLE (table, 0);
- ht_copy_to_c (XHASHTABLE (table), &htbl);
- if (gethash (LISP_TO_VOID (key), &htbl, &vval))
- {
- Lisp_Object val;
- CVOID_TO_LISP (val, vval);
- return val;
- }
- else
- return defalt;
- }
-
-
- DEFUN ("remhash", Fremhash, Sremhash, 2, 2, 0,
- "Remove hash value for KEY in TABLE.")
- (key, table)
- Lisp_Object key, table;
- {
- struct _C_hashtable htbl;
- CHECK_HASHTABLE (table, 0);
-
- ht_copy_to_c (XHASHTABLE (table), &htbl);
- remhash (LISP_TO_VOID (key), &htbl);
- ht_copy_from_c (&htbl, XHASHTABLE (table));
- return Qnil;
- }
-
-
- DEFUN ("puthash", Fputhash, Sputhash, 3, 3, 0,
- "Hash KEY to VAL in TABLE.")
- (key, val, table)
- Lisp_Object key, val, table;
- {
- struct hashtable_struct *ht;
- void *vkey = LISP_TO_VOID (key);
-
- CHECK_HASHTABLE (table, 0);
- ht = XHASHTABLE (table);
- if (!vkey)
- ht->zero_entry = val;
- else
- {
- struct gcpro gcpro1, gcpro2, gcpro3;
- struct _C_hashtable htbl;
-
- ht_copy_to_c (XHASHTABLE (table), &htbl);
- GCPRO3 (key, val, table);
- puthash (vkey, LISP_TO_VOID (val), &htbl);
- ht_copy_from_c (&htbl, XHASHTABLE (table));
- UNGCPRO;
- }
- return (val);
- }
-
- DEFUN ("clrhash", Fclrhash, Sclrhash, 1, 1, 0,
- "Flush TABLE.")
- (table)
- Lisp_Object table;
- {
- struct _C_hashtable htbl;
- CHECK_HASHTABLE (table, 0);
- ht_copy_to_c (XHASHTABLE (table), &htbl);
- clrhash (&htbl);
- ht_copy_from_c (&htbl, XHASHTABLE (table));
- return Qnil;
- }
-
- DEFUN ("hashtable-fullness", Fhashtable_fullness, Shashtable_fullness, 1, 1, 0,
- "Return number of entries in TABLE.")
- (table)
- Lisp_Object table;
- {
- struct _C_hashtable htbl;
- CHECK_HASHTABLE (table, 0);
- ht_copy_to_c (XHASHTABLE (table), &htbl);
- return (make_number (htbl.fullness));
- }
-
-
- static void
- verify_function (Lisp_Object function, char *description)
- {
- if (SYMBOLP (function))
- {
- if (NILP (function))
- return;
- else
- function = indirect_function (function, 1);
- }
- if (SUBRP (function) || BYTECODEP (function))
- return;
- else if (CONSP (function))
- {
- Lisp_Object funcar = Fcar (function);
- if ((SYMBOLP (funcar))
- && (EQ (funcar, Qlambda)
- #ifdef MOCKLISP_SUPPORT
- || EQ (funcar, Qmocklisp)
- #endif
- || EQ (funcar, Qautoload)))
- return;
- }
- signal_error (Qinvalid_function, list1 (function));
- }
-
- static void
- lisp_maphash_function (CONST void *void_key,
- void *void_val,
- void *void_fn)
- {
- /* This function can GC */
- Lisp_Object key, val, fn;
- CVOID_TO_LISP (key, void_key);
- VOID_TO_LISP (val, void_val);
- VOID_TO_LISP (fn, void_fn);
- call2 (fn, key, val);
- }
-
-
- DEFUN ("maphash", Fmaphash, Smaphash, 2, 2, 0,
- "Map FUNCTION over entries in TABLE, calling it with two args,\n\
- each key and value in the table.")
- (function, table)
- Lisp_Object function, table;
- {
- struct _C_hashtable htbl;
- struct gcpro gcpro1, gcpro2;
-
- verify_function (function, GETTEXT ("hashtable mapping function"));
- CHECK_HASHTABLE (table, 0);
- ht_copy_to_c (XHASHTABLE (table), &htbl);
- GCPRO2 (table, function);
- maphash (lisp_maphash_function, &htbl, LISP_TO_VOID (function));
- UNGCPRO;
- return Qnil;
- }
-
-
- /* This function is for mapping a *C* function over the elements of a
- lisp hashtable.
- */
- void
- elisp_maphash (maphash_function function, Lisp_Object table, void *closure)
- {
- struct _C_hashtable htbl;
-
- if (!gc_in_progress) CHECK_HASHTABLE (table, 0);
- ht_copy_to_c (XHASHTABLE (table), &htbl);
- maphash (function, &htbl, closure);
- }
-
- void
- elisp_map_remhash (remhash_predicate function,
- Lisp_Object table,
- void *closure)
- {
- struct _C_hashtable htbl;
-
- if (!gc_in_progress) CHECK_HASHTABLE (table, 0);
- ht_copy_to_c (XHASHTABLE (table), &htbl);
- map_remhash (function, &htbl, closure);
- ht_copy_from_c (&htbl, XHASHTABLE (table));
- }
-
- #if 0
- void
- elisp_table_op (Lisp_Object table, generic_hashtable_op op, void *arg1,
- void *arg2, void *arg3)
- {
- struct _C_hashtable htbl;
- CHECK_HASHTABLE (table, 0);
- ht_copy_to_c (XHASHTABLE (table), &htbl);
- (*op) (&htbl, arg1, arg2, arg3);
- ht_copy_from_c (&htbl, XHASHTABLE (table));
- }
- #endif /* 0 */
-
-
-
- DEFUN ("make-weak-hashtable", Fmake_weak_hashtable, Smake_weak_hashtable,
- 1, 1, 0,
- "Make a fully weak hashtable of initial size SIZE.\n\
- A weak hashtable is one whose pointers do not count as GC referents:\n\
- for any key-value pair in the hashtable, if the only remaining pointer\n\
- to either the key or the value is in a weak hash table, then the pair\n\
- will be removed from the table, and the key and value collected. A\n\
- non-weak hash table (or any other pointer) would prevent the object\n\
- from being collected.\n\
- \n\
- You can also create semi-weak hashtables; see `make-key-weak-hashtable'\n\
- and `make-value-weak-hashtable'.")
- (size)
- Lisp_Object size;
- {
- CHECK_NATNUM (size, 0);
- return make_lisp_hashtable (XINT (size), 0, 0, HASHTABLE_WEAK);
- }
-
- DEFUN ("make-key-weak-hashtable", Fmake_key_weak_hashtable,
- Smake_key_weak_hashtable, 1, 1, 0,
- "Make a key-weak hashtable of initial size SIZE.\n\
- A key-weak hashtable is similar to a fully-weak hashtable (see\n\
- `make-weak-hashtable') except that a key-value pair will be removed\n\
- only if the key remains unmarked outside of weak hashtables. The pair\n\
- will remain in the hashtable if the key is pointed to by something other\n\
- than a weak hashtable, even if the value is not.")
- (size)
- Lisp_Object size;
- {
- CHECK_NATNUM (size, 0);
- return make_lisp_hashtable (XINT (size), 0, 0, HASHTABLE_KEY_WEAK);
- }
-
- DEFUN ("make-value-weak-hashtable", Fmake_value_weak_hashtable,
- Smake_value_weak_hashtable, 1, 1, 0,
- "Make a value-weak hashtable of initial size SIZE.\n\
- A value-weak hashtable is similar to a fully-weak hashtable (see\n\
- `make-weak-hashtable') except that a key-value pair will be removed only\n\
- if the value remains unmarked outside of weak hashtables. The pair will\n\
- remain in the hashtable if the value is pointed to by something other\n\
- than a weak hashtable, even if the key is not.")
- (size)
- Lisp_Object size;
- {
- CHECK_NATNUM (size, 0);
- return make_lisp_hashtable (XINT (size), 0, 0, HASHTABLE_VALUE_WEAK);
- }
-
- struct marking_closure
- {
- int (*obj_marked_p) (Lisp_Object);
- void (*markobj) (Lisp_Object);
- enum hashtable_type type;
- int did_mark;
- };
-
- static void
- marking_mapper (CONST void *key, void *contents, void *closure)
- {
- Lisp_Object keytem, valuetem;
- struct marking_closure *fmh =
- (struct marking_closure *) closure;
-
- /* This function is called over each pair in the hashtable.
- We complete the marking for semi-weak hashtables. */
- CVOID_TO_LISP (keytem, key);
- CVOID_TO_LISP (valuetem, contents);
-
- switch (fmh->type)
- {
- case HASHTABLE_KEY_WEAK:
- if ((fmh->obj_marked_p) (keytem) &&
- !(fmh->obj_marked_p) (valuetem))
- {
- (fmh->markobj) (valuetem);
- fmh->did_mark = 1;
- }
- break;
-
- case HASHTABLE_VALUE_WEAK:
- if ((fmh->obj_marked_p) (valuetem) &&
- !(fmh->obj_marked_p) (keytem))
- {
- (fmh->markobj) (keytem);
- fmh->did_mark = 1;
- }
- break;
-
- default:
- abort (); /* Huh? */
- }
-
- return;
- }
-
- int
- finish_marking_weak_hashtables (int (*obj_marked_p) (Lisp_Object),
- void (*markobj) (Lisp_Object))
- {
- Lisp_Object rest;
- int did_mark = 0;
-
- for (rest = Vweak_hash_tables;
- !NILP (rest);
- rest = XHASHTABLE (rest)->next_weak)
- {
- enum hashtable_type type;
-
- if (! ((*obj_marked_p) (rest)))
- /* The hashtable is probably garbage. Ignore it. */
- continue;
- type = XHASHTABLE (rest)->type;
- if (type == HASHTABLE_KEY_WEAK || type == HASHTABLE_VALUE_WEAK)
- {
- struct marking_closure fmh;
-
- fmh.obj_marked_p = obj_marked_p;
- fmh.markobj = markobj;
- fmh.type = type;
- fmh.did_mark = 0;
- /* Now, scan over all the pairs. For all pairs that are
- half-marked, we may need to mark the other half if we're
- keeping this pair. */
- elisp_maphash (marking_mapper, rest, &fmh);
- if (fmh.did_mark)
- did_mark = 1;
- }
-
- /* #### If alloc.c mark_object changes, this must change also... */
- {
- /* Now mark the vector itself. (We don't need to call markobj
- here because we know that everything *in* it is already marked,
- we just need to prevent the vector itself from disappearing.)
- (The remhash above has taken care of zero_entry.)
- */
- struct Lisp_Vector *ptr = XVECTOR (XHASHTABLE (rest)->harray);
- int len = vector_length (ptr);
- if (len >= 0)
- {
- ptr->size = -1 - len;
- did_mark = 1;
- }
- /* else it's already marked (remember, this function is iterated
- until marking stops) */
- }
- }
-
- return did_mark;
- }
-
- struct pruning_closure
- {
- int (*obj_marked_p) (Lisp_Object);
- };
-
- static int
- pruning_mapper (CONST void *key, CONST void *contents, void *closure)
- {
- Lisp_Object keytem, valuetem;
- struct pruning_closure *fmh =
- (struct pruning_closure *) closure;
-
- /* This function is called over each pair in the hashtable.
- We remove the pairs that aren't completely marked (everything
- that is going to stay ought to have been marked already
- by the finish_marking stage). */
- CVOID_TO_LISP (keytem, key);
- CVOID_TO_LISP (valuetem, contents);
-
- return (! ((*fmh->obj_marked_p) (keytem) &&
- (*fmh->obj_marked_p) (valuetem)));
- }
-
- void
- prune_weak_hashtables (int (*obj_marked_p) (Lisp_Object))
- {
- Lisp_Object rest, prev = Qnil;
- for (rest = Vweak_hash_tables;
- !NILP (rest);
- rest = XHASHTABLE (rest)->next_weak)
- {
- if (! ((*obj_marked_p) (rest)))
- {
- /* This table itself is garbage. Remove it from the list. */
- if (NILP (prev))
- Vweak_hash_tables = XHASHTABLE (rest)->next_weak;
- else
- XHASHTABLE (prev)->next_weak = XHASHTABLE (rest)->next_weak;
- }
- else
- {
- struct pruning_closure fmh;
- fmh.obj_marked_p = obj_marked_p;
- /* Now, scan over all the pairs. Remove all of the pairs
- in which the key or value, or both, is unmarked
- (depending on the type of weak hashtable). */
- elisp_map_remhash (pruning_mapper, rest, &fmh);
- prev = rest;
- }
- }
- }
-
-
-
- /* equality and hash functions for Lisp strings */
- int
- lisp_string_equal (CONST void *x1, CONST void *x2)
- {
- Lisp_Object str1, str2;
- CVOID_TO_LISP (str1, x1);
- CVOID_TO_LISP (str2, x2);
- return !strcmp ((char *) string_data (XSTRING (str1)),
- (char *) string_data (XSTRING (str2)));
- }
-
- unsigned long
- lisp_string_hash (CONST void *x)
- {
- Lisp_Object str;
- CVOID_TO_LISP (str, x);
- return hash_string (string_data (XSTRING (str)),
- string_length (XSTRING (str)));
- }
-
- /* Return a hash value for a Lisp_Object. This is for use when hashing
- objects with the comparison being `equal' (for `eq', you can just
- use the Lisp_Object itself as the hash value). You need to make a
- tradeoff between the speed of the hash function and how good the
- hashing is. In particular, the hash function needs to be FAST,
- so you can't just traipse down the whole tree hashing everything
- together. Most of the time, objects will differ in the first
- few elements you hash. Thus, we only go to a short depth (5)
- and only hash at most 5 elements out of a vector. Theoretically
- we could still take 5^5 time (a big big number) to compute a
- hash, but practically this won't ever happen. */
-
- unsigned long
- internal_hash (Lisp_Object obj, int depth)
- {
- if (depth > 5)
- return 0;
- if (CONSP (obj))
- {
- /* no point in worrying about tail recursion, since we're not
- going very deep */
- return HASH2 (internal_hash (XCAR (obj), depth + 1),
- internal_hash (XCDR (obj), depth + 1));
- }
- #ifndef LRECORD_VECTOR
- else if (VECTORP (obj))
- {
- int i;
- struct Lisp_Vector *v = XVECTOR (obj);
- int len = vector_length (v);
- unsigned long hash = 0;
-
- if (len <= 5)
- {
- for (i = 0; i < len; i++)
- hash = HASH2 (hash, internal_hash (v->contents[i], depth + 1));
- return hash;
- }
-
- /* just pick five elements scattered throughout the vector.
- A slightly better approach would be to offset by some
- noise factor from the points chosen below. */
- for (i = 0; i < 5; i++)
- hash = HASH2 (hash, internal_hash (v->contents[i*len/5], depth + 1));
-
- return hash;
- }
- #endif /* !LRECORD_VECTOR */
- else if (STRINGP (obj))
- return hash_string (string_data (XSTRING (obj)),
- string_length (XSTRING (obj)));
- else if (LRECORDP (obj))
- {
- CONST struct lrecord_implementation
- *imp = XRECORD_LHEADER (obj)->implementation;
- if (imp->hash)
- return ((imp->hash) (obj, depth));
- }
-
- return LISP_HASH (obj);
- }
-
-
- /************************************************************************/
- /* initialization */
- /************************************************************************/
-
- void
- syms_of_elhash (void)
- {
- defsubr (&Smake_hashtable);
- defsubr (&Scopy_hashtable);
- defsubr (&Shashtablep);
- defsubr (&Sgethash);
- defsubr (&Sputhash);
- defsubr (&Sremhash);
- defsubr (&Sclrhash);
- defsubr (&Smaphash);
- defsubr (&Shashtable_fullness);
- defsubr (&Smake_weak_hashtable);
- defsubr (&Smake_key_weak_hashtable);
- defsubr (&Smake_value_weak_hashtable);
- defsymbol (&Qhashtablep, "hashtablep");
- }
-
- void
- vars_of_elhash (void)
- {
- /* This must not be staticpro'd */
- Vweak_hash_tables = Qnil;
- }
-
-